home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / tex / td187src.lzh / MAGICSTR.I < prev    next >
Text File  |  1991-06-21  |  8KB  |  301 lines
  1. (*#######################################################################
  2.                            M A G I C S T R I N G S
  3.   #######################################################################
  4.   V1.1  09.06.91  Jens Pirnay Routinen durch MM2-Bib ersetzt.
  5.   V1.0  18.10.90  Johannes Leckebusch/Peter Hellinger   MM2-Modula-2
  6.   #######################################################################*)
  7.  
  8. IMPLEMENTATION MODULE MagicStrings;
  9.  
  10. (*------------------------------*)
  11. (* MM2-Version: AKTIVIERT       *)
  12. (*------------------------------*)
  13. (*$R-   Range-Checks            *)
  14. (*$S-   Stack-Check             *)
  15. (*                              *)
  16. (*------------------------------*)
  17.  
  18.  
  19. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
  20.                         Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
  21.                         Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
  22.                         sBITSET, lWORD, lINTEGER, lCARDINAL, lBITSET,
  23.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  24.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  25.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr;
  26.  
  27. IMPORT Strings;
  28.  
  29. (** Alles durch Aufrufe der MM2-Bibliothek ersetzt, da hier eine Menge
  30.     Bugs lauern (genaueres steht in der TDI-Version)...  JP
  31.  
  32. (* BEMERKUNG: In diesem Modul werden fuer die Index-Zaehler INTEGER-
  33.  * Variable benutzt, weil es sonst bei Ausdruecken der Form
  34.  * "Laenge - 1" zu Bereichsfehler kommt, wenn Laenge = 0 und
  35.  * Laenge = TYPE CARDINAL.
  36.  *)
  37.  
  38. CONST   Ch0 =   0C;
  39.  
  40.  
  41. PROCEDURE Length (VAR str: ARRAY OF CHAR): sCARDINAL;
  42. VAR i: sCARDINAL;
  43. BEGIN
  44.  FOR i:= 0 TO HIGH (str) DO
  45.   IF  (str[i] = Ch0) THEN  RETURN i;  END;
  46.  END;
  47.  RETURN HIGH (str);
  48. END Length;
  49.  
  50.  
  51. PROCEDURE Equal (s1, s2: ARRAY OF CHAR): BOOLEAN;
  52. VAR i, l1, l2: sINTEGER;
  53. BEGIN
  54.  l1:= Length (s1);
  55.  l2:= Length (s2);
  56.  IF l1 # l2 THEN RETURN FALSE END;
  57.  FOR i:= 0 TO l1 DO
  58.   IF s1[i] # s2[i] THEN RETURN FALSE; END;
  59.  END; (* FOR *)
  60.  RETURN TRUE;
  61. END Equal;
  62.  
  63. (*$Z-*)
  64. PROCEDURE fastCompare (VAR s1, s2: ARRAY OF CHAR): Relation;
  65. (*$Z=*)
  66.   (*$L-*)
  67.   BEGIN
  68.     (*
  69.       IF s1[0] > s2[0] THEN
  70.         RETURN greater
  71.       ELSIF s1[0] < s2[0] THEN
  72.         RETURN less
  73.       ELSE
  74.         RETURN Compare (s1,s2)
  75.       END
  76.     *)
  77.     ASSEMBLER
  78.         MOVE.L  -12(A3),A1      ; ADR (s1)
  79.         MOVE.L  -06(A3),A2      ; ADR (s2)
  80.         MOVE.B  (A1),D1         ; s1[0]
  81.         MOVE.B  (A2),D2         ; s2[0]
  82.         CMP.B   D2,D1
  83.         BHI     gr
  84.         BCS     le
  85.         JMP     Compare         ; s1[0] = s2[0]
  86.     le: SUBA.W  #12,A3
  87.         MOVE    #less,(A3)+
  88.         RTS
  89.     gr: SUBA.W  #12,A3
  90.         MOVE    #greater,(A3)+
  91.     END
  92.   END fastCompare;
  93.   (*$L=*)
  94.  
  95. PROCEDURE Compare (s1, s2: ARRAY OF CHAR): Relation;
  96. VAR l, i, l1, l2: sINTEGER;
  97.     equ: Relation;
  98. BEGIN
  99. (**
  100.  equ:= equal;
  101.  l1:= Length (s1);
  102.  l2:= Length (s2);
  103.  IF l1 > l2 THEN  l:= l2;  ELSE  l:= l1;  END;
  104.  i:= 0;
  105.  WHILE (i < l) AND (equ = equal) DO
  106.   IF s1[i] > s2[i] THEN  equ:= greater
  107.   ELSIF s1[i] < s2[i] THEN  equ:= less;
  108.   END;
  109.   INC (i);
  110.  END;
  111.  IF equ = equal THEN
  112.   IF l1 > l2 THEN  equ:= greater
  113.   ELSIF l1 < l2 THEN  equ:= less
  114.   END;
  115.  END;
  116.  RETURN equ;
  117. **) 
  118.   RETURN fastCompare(s1, s2);
  119. END Compare;
  120.  
  121.  
  122. PROCEDURE Assign (quelle: ARRAY OF CHAR; VAR ziel: ARRAY OF CHAR);
  123. VAR i, l, hq, hz: sCARDINAL;
  124. BEGIN
  125.  FOR i:= 0 TO HIGH (ziel) DO
  126.   IF (quelle[i] = Ch0) OR (i > HIGH(quelle)) THEN
  127.    ziel[i]:= Ch0;
  128.    RETURN;
  129.   END;
  130.   ziel[i]:= quelle[i];
  131.  END;
  132. END Assign;
  133.  
  134.  
  135. PROCEDURE Pos (substr, str: ARRAY OF CHAR): sCARDINAL;
  136. VAR index, i, laenge, h: sINTEGER;
  137.     gefunden: BOOLEAN;
  138.     test:     BOOLEAN;
  139. BEGIN
  140.  index:= 0;  gefunden:= FALSE;  laenge:= Length (substr);  h:= HIGH (str);
  141.  WHILE NOT gefunden AND ((index + laenge) <= h) DO
  142.   test:= TRUE;  i:= 0;
  143.   WHILE (i < laenge) AND test DO
  144.    test:= substr [i] = str [index + i];  INC (i);
  145.   END;
  146.   gefunden:= test;
  147.   INC (index);
  148.  END (* WHILE NOT gefunden *);
  149.  IF (gefunden) AND (index > 0) THEN  RETURN index - 1;
  150.                                ELSE  RETURN h + 1;
  151.  END;
  152. END Pos;
  153.  
  154.  
  155. PROCEDURE Insert (substr: ARRAY OF CHAR; VAR str: ARRAY OF CHAR; inx: sCARDINAL);
  156. VAR i, in, h, l, l1: sINTEGER;
  157. BEGIN
  158.  l1:= Length (substr);  h:= HIGH (str);  in:= inx;
  159.  IF l1 = 0 THEN RETURN END;
  160.  l:= Length (str);  l:= l + l1 - 1;
  161.  FOR i:= l TO (in + l1) BY -1 DO  str[i]:= str[i - l1];  END;
  162.  IF (l + 1) <= h THEN str [l + 1]:= Ch0; END;
  163.  FOR i:= 0 TO l1 - 1 DO  str[i + in]:= substr[i];  END;
  164. END Insert;
  165.  
  166.  
  167. PROCEDURE Delete (VAR str: ARRAY OF CHAR; inx, len: sCARDINAL);
  168. VAR i, l, h, in, le: sINTEGER;
  169. BEGIN
  170.  l:= Length (str);  in:= inx;  le:= len;  h:= HIGH (str);
  171.  FOR i:= in TO (l - le) - 1 DO  str[i]:= str[i + le];  END;
  172.  IF (l - le) <= h THEN  str[l - le]:= Ch0;
  173.  END;
  174. END Delete;
  175.  
  176.  
  177. PROCEDURE Append (substr: ARRAY OF CHAR; VAR str: ARRAY OF CHAR);
  178. VAR i, j, l: sCARDINAL;
  179. BEGIN
  180.  l:= Length (str);  j:= 0;
  181.  FOR i:= l TO HIGH(str) DO
  182.   IF (substr[j] = Ch0) OR (j > HIGH(substr)) THEN
  183.    str[i]:= Ch0;
  184.    RETURN;
  185.   END;
  186.   str[i]:= substr[j];  INC (j);
  187.  END;
  188. END Append;
  189.  
  190.  
  191. PROCEDURE Copy (VAR str: ARRAY OF CHAR; inx, len: sCARDINAL;
  192.                 VAR result: ARRAY OF CHAR);
  193. VAR i, in, le, h: sINTEGER;
  194. BEGIN
  195.  in:= inx;  le:= len;  h:= HIGH (result);
  196.  FOR i:= 0 TO le - 1 DO  result[i]:= str[in + i];  END;
  197.  IF le <= h THEN  result [le]:= Ch0;  END;
  198. END Copy;
  199.  
  200.  
  201. PROCEDURE CAPS (VAR str: ARRAY OF CHAR);
  202. VAR i, l:  INTEGER;
  203. BEGIN
  204.  l:= Length (str);
  205.  FOR i:= 0 TO l - 1 DO  str[i]:= Cap (str[i]);  END;
  206. END CAPS;
  207.  
  208.  
  209. PROCEDURE Cap (ch: CHAR): CHAR;
  210. BEGIN
  211.  CASE ch OF
  212.   'ä': RETURN 'Ä';|
  213.   'ö': RETURN 'Ö';|
  214.   'ü': RETURN 'Ü';|
  215.   'é': RETURN 'É';|
  216.   'à': RETURN 'À';|
  217.   'å': RETURN 'Å';|
  218.   'ç': RETURN 'Ç';|
  219.   'æ': RETURN 'Æ';|
  220.   'ñ': RETURN 'Ñ';|
  221.   'ã': RETURN 'Ã';|
  222.   'õ': RETURN 'Õ';|
  223.   'ø': RETURN 'Ø';|
  224.   'œ': RETURN 'Œ';|
  225.   ELSE RETURN CAP(ch);
  226.  END;
  227. END Cap;
  228. **)
  229.  
  230. PROCEDURE Length  (REF str: ARRAY OF CHAR): sCARDINAL;
  231. BEGIN
  232.   RETURN LENGTH(str); (* neue ISO-Standard-Funktion *)
  233. END Length;
  234.  
  235. PROCEDURE Pos     (substr, str: ARRAY OF CHAR): sCARDINAL;
  236. VAR i : sINTEGER;
  237. BEGIN
  238.   i := Strings.Pos(substr, str, 0);
  239.   IF i<0 THEN
  240.     RETURN HIGH(str) + 1;
  241.    ELSE
  242.     RETURN CastToCard(i);
  243.   END;
  244. END Pos;
  245.  
  246. PROCEDURE Insert  (substr: ARRAY OF CHAR; VAR str: ARRAY OF CHAR; index: sCARDINAL);
  247. VAR success : BOOLEAN;
  248. BEGIN
  249.   Strings.Insert(substr, CastToInt(index), str, success);
  250. END Insert;
  251.  
  252. PROCEDURE Delete  (VAR str: ARRAY OF CHAR; index, len: sCARDINAL);
  253. VAR success : BOOLEAN;
  254. BEGIN
  255.   Strings.Delete(str, index, len, success);
  256. END Delete;
  257.  
  258. PROCEDURE Append  (substr: ARRAY OF CHAR; VAR str: ARRAY OF CHAR);
  259. VAR success : BOOLEAN;
  260. BEGIN
  261.   Strings.Append(substr, str, success);
  262. END Append;
  263.  
  264. PROCEDURE Copy    (REF str: ARRAY OF CHAR; index, len: sCARDINAL;
  265.                    VAR result: ARRAY OF CHAR);
  266. VAR success : BOOLEAN;
  267. BEGIN
  268.   Strings.Copy(str, CastToInt(index), CastToInt(len), result, success);
  269. END Copy;
  270.  
  271. PROCEDURE CAPS    (VAR str: ARRAY OF CHAR);
  272. BEGIN
  273.   Strings.Upper(str);
  274. END CAPS;
  275.  
  276. PROCEDURE Equal   (s1, s2: ARRAY OF CHAR): BOOLEAN;
  277. BEGIN
  278.   RETURN Strings.StrEqual(s1, s2);
  279. END Equal;
  280.  
  281. PROCEDURE Compare (s1, s2: ARRAY OF CHAR): Relation;
  282. VAR res : Strings.Relation;
  283. BEGIN
  284.   res := Strings.Compare(s1, s2);
  285.   RETURN Relation(res);
  286. END Compare;
  287.  
  288. PROCEDURE Assign  (quelle: ARRAY OF CHAR; VAR ziel: ARRAY OF CHAR);
  289. VAR success : BOOLEAN;
  290. BEGIN
  291.   Strings.Assign(quelle, ziel, success);
  292. END Assign;
  293.  
  294. PROCEDURE Cap     (ch: CHAR): CHAR;
  295. (* Wandelt auch deutsche Umlaute *)
  296. BEGIN
  297.   RETURN CAP(ch); (* macht das Standard-MM2 schon *)
  298. END Cap;
  299.  
  300. END MagicStrings.
  301.